home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / util / gnu / gnu_smalltalk1_2.lha / mstdict.c < prev    next >
C/C++ Source or Header  |  1992-02-15  |  61KB  |  2,400 lines
  1. /***********************************************************************
  2.  *
  3.  *    Dictionary Support Module.
  4.  *
  5.  ***********************************************************************/
  6.  
  7. /***********************************************************************
  8.  *
  9.  * Copyright (C) 1990, 1991, 1992 Free Software Foundation, Inc.
  10.  * Written by Steve Byrne.
  11.  *
  12.  * This file is part of GNU Smalltalk.
  13.  *
  14.  * GNU Smalltalk is free software; you can redistribute it and/or modify it
  15.  * under the terms of the GNU General Public License as published by the Free
  16.  * Software Foundation; either version 1, or (at your option) any later 
  17.  * version.
  18.  * 
  19.  * GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
  20.  * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 
  21.  * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
  22.  * more details.
  23.  * 
  24.  * You should have received a copy of the GNU General Public License along with
  25.  * GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
  26.  * Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  
  27.  *
  28.  ***********************************************************************/
  29.  
  30.  
  31. /*
  32.  *    Change Log
  33.  * ============================================================================
  34.  * Author      Date       Change 
  35.  * sbb         15 Sep 91      Fixed dictionaryAssociationAt: to not loop when the
  36.  *              dictionary is full.  Thanks to Michael Richardson for
  37.  *              the fix!
  38.  *
  39.  * sbb         14 Sep 91      Switched to global version string.
  40.  *
  41.  * sbb          6 Jul 91      added newString (create uninitialized string of a
  42.  *              given length).
  43.  *
  44.  * sbb         13 Apr 91      Added Features global variable.  This allows for
  45.  *              conditional execution based on operating system or
  46.  *              machine architecture, and at some point, conditional
  47.  *              compilation.
  48.  *
  49.  * sbb         24 Mar 91      Float's class definition said that it was not
  50.  *              pointers, not words, and not indexable.  When new
  51.  *              instances were created, they were 2 BYTES large,
  52.  *              instead of 2 words.  Changed to have the words flag
  53.  *              on.
  54.  *
  55.  * sbb          3 Aug 90      Added allocCObject.
  56.  *
  57.  * sbyrne    21 Apr 90      Added toByteArray.
  58.  *
  59.  * sbyrne     7 Jan 90      Added more commentary to classes, added new global
  60.  *              Smalltalk variable: Bigendian, which allows code 
  61.  *              to be conditional based on the architecture type.
  62.  *
  63.  * sbyrne     7 Sep 89      Started adding garbage collection support.
  64.  *
  65.  * sbyrne    29 May 89      Added the memory classes.  Added the FileStream about
  66.  *              a week ago.
  67.  *
  68.  * sbyrne    29 Apr 89      Author changed from single to married.
  69.  *
  70.  * sbyrne     5 Apr 89      Restructured Class and Metaclass creation.  Is now
  71.  *              table driven, and metaclasses are created containing
  72.  *              the proper information.
  73.  *
  74.  * sbyrne    29 Mar 89      Removed MethodDictionary as a separate type; it is an
  75.  *              IdentityDictionary. 
  76.  *
  77.  * sbyrne    11 Mar 89      Smalltalk is now an instance of SystemDictionary.
  78.  *
  79.  * sbyrne    13 Jan 89      Created.
  80.  *
  81.  */
  82.  
  83.  
  84. #include "mst.h"
  85. #include "mstdict.h"
  86. #include "mstoop.h"
  87. #include "mstinterp.h"
  88. #include "mststr.h"
  89. #include "mstsym.h"
  90. #include "mstlib.h"
  91. #include <stdio.h>
  92.  
  93. #define INITIAL_DICTIONARY_SIZE        32 /* chosen at random */
  94.  
  95. /* undefine this to enable direct calls to the corresponding routines,
  96.    typically done for debugging or profiling */
  97. #define DICT_INLINES
  98.  
  99.  
  100. #ifdef DICT_INLINES
  101.  
  102. #define classInstanceSpec(classOOP) \
  103.   (((Class)oopToObj(classOOP))->instanceSpec)
  104.  
  105. #endif /* DICT_INLINES */
  106.  
  107.  
  108.  
  109. /***********************************************************************
  110.  *
  111.  *    Below are the structural definitions for several of the important
  112.  *    objects present in the Smalltalk system.  Their C representation
  113.  *    corresponds exactly with their Smalltalk representation.
  114.  *
  115.  ***********************************************************************/
  116.  
  117. typedef struct DictionaryStruct {
  118.   OBJ_HEADER;
  119.   OOP        tally;        /* really, an int */
  120.   OOP        assoc[1];    /* variable sized array of associations */
  121.   /* Other, indexable fields that are the associations for this dictionary */
  122. } *Dictionary;
  123.  
  124. typedef struct IdentityDictionaryStruct {
  125.   OBJ_HEADER;
  126.   OOP        tally;        /* really, an int */
  127.   OOP        values;        /* an Array */
  128.   OOP        keys[1];    /* variable sized array of OOPS (symbols) */
  129. } *IdentityDictionary;
  130.  
  131. typedef struct AssociationStruct {
  132.   OBJ_HEADER;
  133.   OOP        key;
  134.   OOP        value;
  135. } *Association;
  136.  
  137. typedef struct ArrayStruct {
  138.   OBJ_HEADER;
  139.   OOP        elements[1];    /* elements of the array */
  140. } *Array;
  141.  
  142. typedef struct FloatObjectStruct {
  143.   OBJ_HEADER;
  144.   double    value;
  145. } *FloatObject;
  146.  
  147. typedef struct StringStruct {
  148.   OBJ_HEADER;
  149.   char        chars[1];
  150. } *String;
  151.  
  152. typedef struct ByteArrayStruct {
  153.   OBJ_HEADER;
  154.   Byte        bytes[1];
  155. } *ByteArray;
  156.  
  157. typedef struct MessageStruct {
  158.   OBJ_HEADER;
  159.   OOP        selector;
  160.   OOP        args;
  161. } *Message;
  162.  
  163. typedef struct ClassInfoStruct {
  164.   OOP        *classVar;
  165.   OOP        *superClassPtr;
  166.   Boolean    isPointers;
  167.   Boolean    isWords;
  168.   Boolean    isIndexable;
  169.   char        numFixedFields;
  170.   char        *name;
  171.   char        *instVarNames;
  172.   char        *classVarNames;
  173.   char        *sharedPoolNames;
  174.   char        *comment;
  175. } ClassInfo;
  176.  
  177. /* Primary class variables. These variables hold the class objects for
  178.    all of the builtin classes in the system */
  179. OOP            objectClass, magnitudeClass, charClass, timeClass,
  180.             dateClass,
  181.             numberClass, floatClass, integerClass, lookupKeyClass,
  182.             associationClass, linkClass, processClass,
  183.             symLinkClass, collectionClass,
  184.             sequenceableCollectionClass, linkedListClass,
  185.             semaphoreClass,
  186.             arrayedCollectionClass, arrayClass, stringClass,
  187.             symbolClass, byteArrayClass, compiledMethodClass,
  188.             intervalClass, orderedCollectionClass,
  189.             sortedCollectionClass, bagClass, mappedCollectionClass,
  190.             setClass, dictionaryClass, 
  191.             systemDictionaryClass,
  192.             identityDictionaryClass, undefinedObjectClass,
  193.             booleanClass, falseClass, trueClass, 
  194.             processorSchedulerClass, delayClass, sharedQueueClass,
  195.             behaviorClass,
  196.             classDescriptionClass, classClass, metaclassClass,
  197.             smalltalkDictionary, messageClass, methodContextClass,
  198.             blockContextClass, 
  199.             streamClass, positionableStreamClass, readStreamClass,
  200.             writeStreamClass, readWriteStreamClass,
  201.             cObjectClass, cTypeClass, fileStreamClass, memoryClass,
  202.             byteMemoryClass, wordMemoryClass, randomClass,
  203.             cFuncDescriptorClass, tokenStreamClass,
  204.             methodInfoClass, fileSegmentClass,
  205.             processorOOP;
  206.  
  207. void             setAssociationValue();
  208.  
  209. static Dictionary    growDictionary();
  210. static IdentityDictionary growIdentityDictionary();
  211. #ifndef DICT_INLINES
  212. static InstanceSpec    classInstanceSpec();
  213. #endif 
  214. static OOP        identityDictionaryNew(), systemDictionaryNew(),
  215.             newClass(), newMetaclass();
  216. static void        initSmalltalkDictionary(), addSmalltalk(),
  217.             printOOPClassName(), printClassName(),
  218.             createClassesPass1(), createClassesPass2(),
  219.             addSubClass(), addSTDIOObject();
  220. static int        oopNumFields();
  221.  
  222. static char *featureStrings[] = {
  223. #ifdef MACHINE_DEFINES
  224.   MACHINE_DEFINES, 
  225. #endif
  226.   NULL
  227. };
  228.  
  229. /* The class definition structure.  From this structure, the initial set of
  230.    Smalltalk classes are defined.  Note that the comment field is largely
  231.    superfluous, thanks to the comment: primitive and the universal use
  232.    of the class and class comment declarations throughout the Smalltalk
  233.    method definition files.  In any dispute, the comment definition in the
  234.    ".st" file wins. */
  235.  
  236. static ClassInfo classInfo[] = {
  237.   { &objectClass,        nil,
  238.       true,    false,    false,    0,
  239.       "Object",        nil,    nil,    "Smalltalk CFunctionDescs",
  240.       "I am the root of the Smalltalk class system. \n\
  241. All classes in the system are subclasses of me." },
  242.  
  243.   { &magnitudeClass,        &objectClass,
  244.       true,    false,    false,    0,
  245.       "Magnitude",    nil,    nil,    nil,
  246.       nil },
  247.  
  248.   { &messageClass,        &objectClass,
  249.       true,    false,    false,    2,
  250.       "Message",    "selector args",    nil,    nil,
  251.       nil },
  252.  
  253.   { &charClass,            &magnitudeClass,
  254.       false,    true,    true,    0, /* really has 1 indexed var */
  255.       "Character",    nil,    nil,    nil,
  256.       "My instances represent the 256 characters of the character set.  I provide\n\
  257. messages to translate between integers and character objects, and provide \n\
  258. names for some of the common unprintable characters." },
  259.  
  260.   { &timeClass,            &magnitudeClass,
  261.       true,    false,    false,    1,
  262.       "Time",        "seconds",    nil,    nil,
  263.       nil },
  264.  
  265.   { &dateClass,            &magnitudeClass,
  266.       true,    false,    false,    1,
  267.       "Date",        "days",    nil,    nil,
  268.       nil },
  269.  
  270.   { &numberClass,        &magnitudeClass,
  271.       true,    false,    false,    0,
  272.       "Number",        nil,    nil,    nil,
  273.       nil },
  274.  
  275.   { &floatClass,        &numberClass,
  276.       false,    true,    false,    0,    /* really 2, but we're variable sized*/
  277.       "Float",        nil,    nil,    nil,
  278.       nil },
  279.  
  280.   { &integerClass,               &numberClass,
  281.       false,    true,    false,    0,
  282.       "Integer",    nil,    nil,    nil,
  283.       nil },
  284.  
  285.   { &lookupKeyClass,        &magnitudeClass,
  286.       true,    false,    false,    0,
  287.       "LookupKey",    nil,    nil,    nil,
  288.       nil },
  289.  
  290.   { &associationClass,        &lookupKeyClass,
  291.       true,    false,    false,    2,
  292.       "Association",    "key value",    nil,    nil,
  293.       nil },
  294.  
  295.   { &linkClass,            &objectClass,
  296.       true,    false,    false,    1,
  297.       "Link",            "nextLink",    nil,    nil,
  298.       nil },
  299.  
  300.   { &processClass,        &linkClass,
  301.       true,    false,    false,    3,
  302.       "Process",    "suspendedContext priority myList",    nil,    nil,
  303.       nil },
  304.  
  305.   { &symLinkClass,        &linkClass,
  306.       true,    false,    false,    1,
  307.       "SymLink",    "symbol",    nil,    nil,
  308.       nil },
  309.  
  310.   { &collectionClass,        &objectClass,
  311.       true,    false,    false,    0,
  312.       "Collection",    nil,    nil,    nil,
  313.       nil },
  314.  
  315.   { &sequenceableCollectionClass,    &collectionClass,
  316.       true,    false,    true,    0,
  317.       "SequenceableCollection",    nil,    nil,    nil,
  318.       nil },
  319.  
  320.   { &linkedListClass,        &sequenceableCollectionClass,
  321.       true,    false,    false,    2,
  322.       "LinkedList",    "firstLink lastLink",    nil,    nil,
  323.       nil },
  324.  
  325.   { &semaphoreClass,        &linkedListClass,
  326.       true,    false,    false,    1,
  327.       "Semaphore",    "signals",    nil,    nil,
  328.       nil },
  329.  
  330.   { &arrayedCollectionClass,    &sequenceableCollectionClass,
  331.       true,    false,    true,    0,
  332.       "ArrayedCollection",    nil,    nil,    nil,
  333.       nil },
  334.  
  335.   { &arrayClass,        &arrayedCollectionClass,
  336.       true,    false,    true,    0,
  337.       "Array",      nil,    nil,    nil,
  338.       nil },
  339.  
  340.   { &stringClass,        &arrayedCollectionClass,
  341.       false,    false,    true,    0,
  342.       "String",        nil,    nil,    nil,
  343.       nil },
  344.  
  345.   { &symbolClass,        &stringClass,
  346.       false,    false,    true,    0,
  347.       "Symbol",        nil,    nil,    nil,
  348.       nil },
  349.  
  350.   { &byteArrayClass,        &arrayedCollectionClass,
  351.       false,    false,    true,    0,
  352.       "ByteArray",    nil,    nil,    nil,
  353.       nil },
  354.  
  355.   { &compiledMethodClass,    &arrayedCollectionClass,
  356.       false,    false,    true,    2, /* leave this this way */
  357.       "CompiledMethod",    "descriptor methodHeader",    nil,    nil, 
  358.       "I represent methods that have been compiled.  I can recompile \n\
  359. methods from their source code, I can invoke Emacs to edit the source code \n\
  360. for one of my instances, and I know how to access components of my \n\
  361. instances." },
  362.  
  363.   { &intervalClass,    &sequenceableCollectionClass,
  364.       true,    false,    false,    3,
  365.       "Interval",    "start stop step", nil,    nil,
  366.       "My instances represent ranges of objects, typically Magnitude type\n\
  367. objects.  I provide iteration/enumeration messages for producing all the\n\
  368. members that my instance represents." },
  369.  
  370.   { &orderedCollectionClass,    &sequenceableCollectionClass,
  371.       true,    false,    true,    2,
  372.       "OrderedCollection",    "firstIndex lastIndex",    nil,    nil,
  373.       nil },
  374.  
  375.   { &sortedCollectionClass,    &orderedCollectionClass,
  376.       true,    false,    true,    1,
  377.       "SortedCollection",    "sortBlock",    nil,    nil,
  378.       "I am a collection of objects, stored and accessed according to some\n\
  379. sorting criteria.  I store things using a bubble sort.  My instances have a \n\
  380. comparison block associated with them; this block takes two arguments and\n\
  381. is a predicate which returns true if the first argument should be sorted \n\
  382. earlier than the second.  The default block is [ :a :b | a <= b ], but I\n\
  383. will accept any block that conforms to the above criteria." },
  384.  
  385.   { &bagClass,    &collectionClass,
  386.       true,    false,    false,    1,
  387.       "Bag",        "contents",    nil,    nil,
  388.       "My instances are unordered collections of objects.  You can think\n\
  389. of me as a set with a memory; that is, if the same object is added to me\n\
  390. twice, then I will report that that element has been stored twice." },
  391.  
  392.   { &mappedCollectionClass,    &collectionClass,
  393.       true,    false,    false,    2,
  394.       "MappedCollection",    "domain map",    nil,    nil,
  395.       nil },
  396.  
  397.   { &setClass,    &collectionClass,
  398.       true,    false,    true,    1,
  399.       "Set",        "tally",    nil,    nil,
  400.       "I am the typical set object; I can store any objects uniquely.  I\n\
  401. use the = operator to determine duplication of objects." },
  402.  
  403.   { &dictionaryClass,    &setClass,
  404.       true,    false,    true,    0,
  405.       "Dictionary",    nil,    nil,    nil,
  406.       "I implement a dictionary, which is an object that is indexed by \n\
  407. unique objects (typcially instances of Symbol), and associates another \n\
  408. object with that index.  I use the equality operator = to determine \n\
  409. equality of indices." },
  410.  
  411.   { &identityDictionaryClass,        &dictionaryClass,
  412.       true,    false,    true,    1,
  413.       "IdentityDictionary",    "values",    nil,    nil,
  414.       "I am similar to dictionary, except that my representation is \n\
  415. different, and I use the object identity comparision message == to \n\
  416. determine equivalence of indices." },
  417.  
  418.   /* MUST have the same structure as dictionary; they're used interchangeably
  419.    * within the C portion of the system */
  420.   { &systemDictionaryClass,        &dictionaryClass,
  421.       true,    false,    true,    0, 
  422.       "SystemDictionary",    nil,    nil,    nil,
  423.       nil },
  424.  
  425.   { &streamClass,        &objectClass,
  426.       true,    false,    false,    0,
  427.       "Stream",        nil,    nil,    nil,
  428.       nil },
  429.  
  430.   { &tokenStreamClass,        &streamClass,
  431.       true,    false,    false,    1,
  432.       "TokenStream",        "charStream",    nil,    nil,
  433.       "I am not a typical part of the Smalltalk kernel class hierarchy.\n\
  434. I operate on a stream of characters and return distinct \n\
  435. (whitespace-delimited) groups of characters." },
  436.  
  437.   { &positionableStreamClass,    &streamClass,
  438.       true,    false,    false,    4,
  439.       "PositionableStream",    "collection ptr endPtr access",    nil,    nil,
  440.       nil },
  441.  
  442.   { &readStreamClass,        &positionableStreamClass,
  443.       true,    false,    false,    0,
  444.       "ReadStream",    nil,    nil,    nil,
  445.       nil },
  446.  
  447.   { &writeStreamClass,        &positionableStreamClass,
  448.       true,    false,    false,    1,
  449.       "WriteStream",    "maxSize",    nil,    nil,
  450.       nil },
  451.  
  452.   { &readWriteStreamClass,    &writeStreamClass,
  453.       true,    false,    false,    0,
  454.       "ReadWriteStream",    nil,    nil,    nil,
  455.       nil },
  456.  
  457.   { &fileStreamClass,        &readWriteStreamClass,
  458.       true,    false,    false,    3,
  459.       "FileStream",    "file name buffer",        "verbose",    nil,
  460.       "My instances are what conventional programmers think of as files.\n\
  461. My instance creation methods accept the name of a disk file (or any named \n\
  462. file object, such as /dev/rmt0 on UNIX or MTA0: on VMS)." },
  463.  
  464.   { &randomClass,        &streamClass,
  465.       true,    false,    false,    1,
  466.       "Random",        "seed",        nil,    nil,
  467.       nil },
  468.  
  469.   { &undefinedObjectClass,        &objectClass,
  470.       true,    false,    false,    0,
  471.       "UndefinedObject",    nil,    nil,    nil,
  472.       "I have the questionable distinction of being a class with only one\n\
  473. instance, which is the object \"nil\".  I suspect that I should be sent\n\
  474. messages when errors occur, but currently I am not." },
  475.  
  476.   { &booleanClass,        &objectClass,
  477.       true,    false,    false,    0,
  478.       "Boolean",    nil,    nil,    nil,
  479.       nil },
  480.  
  481.   { &falseClass,        &booleanClass,
  482.       true,    false,    false,    1,
  483.       "False",        "truthValue",    nil,    nil, /* ### what's the inst var name in ST-80? */
  484.       nil },
  485.  
  486.   { &trueClass,        &booleanClass,
  487.       true,    false,    false,    1,
  488.       "True",        "truthValue",    nil,    nil, /* ### what's the inst var name in ST-80? */
  489.       nil },
  490.  
  491.   { &processorSchedulerClass,    &objectClass,
  492.       true,    false,    false,    2,
  493.       "ProcessorScheduler",    "processLists activeProcess",    nil,    nil,
  494.       nil },
  495.  
  496.   { &delayClass,    &objectClass,
  497.       true,    false,    false,    2,
  498.       "Delay",    "resumptionTime isRelative",
  499.       "DelayQueue DelayTimeout DelayIdle",    nil,
  500.       nil },
  501.  
  502.   { &sharedQueueClass,    &objectClass,
  503.       true,    false,    false,    3, 
  504.       "SharedQueue",    "queueSem valueReady queue",    nil,    nil,
  505.       nil },
  506.  
  507.   /* Change this, classDescription, or Class, and you must change 
  508.    * the implementaion of newMetaclass some */
  509.   { &behaviorClass,        &objectClass,
  510.       true,    false,    false,    4,
  511.       "Behavior",    "superClass subClasses methodDictionary instanceSpec",
  512.       nil,    nil,
  513.       nil },
  514.  
  515.   { &classDescriptionClass,        &behaviorClass,
  516.       true,    false,    false,    4,
  517.       "ClassDescription",    "name comment instanceVariables category",
  518.       nil,    nil,
  519.       nil },
  520.  
  521.   { &classClass,        &classDescriptionClass,
  522.       true,    false,    false,    2,
  523.       "Class",    "classVariables sharedPools",    nil,    nil,
  524.       nil },
  525.  
  526.   { &metaclassClass,        &classDescriptionClass,
  527.       true,    false,    false,    1,
  528.       "Metaclass",    "instanceClass",    nil,    nil,
  529.       nil },
  530.  
  531.   { &methodContextClass,        &objectClass,
  532.       true,    false,    true,    8,
  533.       "MethodContext",    "sender ip sp method methodClass block selector receiver",    nil,    nil,
  534.       nil },
  535.  
  536.   { &blockContextClass,        &objectClass,
  537.       true,    false,    true,    8,
  538.       "BlockContext",    "caller ip sp numArgs methodClass initialIP selector home",    nil,
  539.      nil,
  540.       nil },
  541.  
  542. /***********************************************************************
  543.  *
  544.  *    End of Standard Smalltalk Class definitions.  The definitions below are
  545.  *    specific to GNU Smalltalk.
  546.  *
  547.  ***********************************************************************/
  548.  
  549.   { &cObjectClass,        &objectClass,
  550.       false,    true,    true,    0,
  551.       "CObject",    nil,    nil,    nil,
  552.       "I am not part of the standard Smalltalk kernel class hierarchy.\n\
  553. My instances contain values that are not interpreted by the Smalltalk \n\
  554. system; they frequently hold \"pointers\" to data outside of the Smalltalk\n\
  555. environment.  The C callout mechanism allows my instances to be transformed\n\
  556. into their corresponding C values for use in external routines." },
  557.  
  558.   { &cTypeClass,        &objectClass,
  559.       true,    false,    false,    3,
  560.       "CType",    "subType baseType numElements",    nil,    nil,
  561.       "I am not part of the standard Smalltalk kernel class hierarchy.\n\
  562. I contain type information used by subclasses of CObject, which represents\n\
  563. external C data items." },
  564.  
  565.   { &cFuncDescriptorClass,    &objectClass,
  566.       true,    false,    true,    4,
  567.       "CFunctionDescriptor",    "cFunction cFunctionName returnType numFixedArgs",
  568.       nil,    nil,
  569.       nil },
  570.  
  571.   { &memoryClass,        &objectClass,
  572.       false,    true,    true,    0,
  573.       "Memory",        nil,    nil,    nil,
  574.       nil },
  575.  
  576.   { &byteMemoryClass,        &memoryClass,
  577.       false,    false,    true,    0,
  578.       "ByteMemory",    nil,    nil,    nil,
  579.       nil },
  580.  
  581.   { &wordMemoryClass,        &memoryClass,
  582.       false,    true,    true,    0,
  583.       "WordMemory",    nil,    nil,    nil,
  584.       nil },
  585.  
  586.   { &methodInfoClass,        &objectClass,
  587.       true,    false,    false,    2,
  588.       "MethodInfo",    "sourceCode category",    nil,    nil,
  589.       nil },
  590.  
  591.   { &fileSegmentClass,        &objectClass,
  592.       true,    false,    false,    3,
  593.       "FileSegment",    "fileName startPos length",    nil,    nil,
  594.       nil },
  595.  
  596.   { nil }
  597.  
  598. /* Smalltalk classes not defined:
  599.    Fraction
  600.    SmallInteger, LargeInteger
  601.    Bitmap, DisplayBitmap, RunArray
  602.    Text
  603.    FileDirectory, FilePage (probably never will be defined)
  604.    Point, Rectangle, BitBlt, CharacterScanner, Pen 
  605.    DisplayObject hierarchy
  606.  */
  607.  
  608. };
  609.  
  610.  
  611. /*
  612.  *    initDictionary()
  613.  *
  614.  * Description
  615.  *
  616.  *    Creates the kernel classes of the Smalltalk system.  Operates in two
  617.  *    passes: pass1 creates the class objects, but they're not completely
  618.  *    initialized.  pass2 finishes the initialization process.  The garbage
  619.  *    collector can NOT run during this time.
  620.  *
  621.  */
  622. void initDictionary()
  623. {
  624.   createClassesPass1();
  625.  
  626.   initCharTable();        /* we can do this now that char class def'd */
  627.   initNil();
  628.   initBooleans();
  629.  
  630.   initSmalltalkDictionary();
  631.  
  632.   createClassesPass2();
  633.  
  634.   initSTDIOObjects();
  635. }
  636.  
  637. static void createClassesPass1()
  638. {
  639.   ClassInfo    *ci;
  640.   OOP        parentClassOOP;
  641.  
  642.   /* Because all of the classes in classInfo are in the root set, we
  643.    * never need to validate them */
  644.   for (ci = classInfo; ci->classVar; ci++) {
  645.     if (ci->superClassPtr == nil) {
  646.       parentClassOOP = (OOP)nil;
  647.     } else {
  648.       parentClassOOP = *ci->superClassPtr;
  649.     }
  650.       
  651.     *ci->classVar = newClass(parentClassOOP, ci->isPointers, ci->isWords,
  652.                  ci->isIndexable, ci->numFixedFields);
  653.   }
  654. }
  655.  
  656. /* runs before GC turned on */
  657. static void  createClassesPass2()
  658. {
  659.   ClassInfo    *ci;
  660.   OOP        classOOP, superClassOOP;
  661.   Class        class, superClass;
  662.   long        index;
  663.  
  664.   /* Because all of the classes in classInfo are in the root set, we
  665.    * never need to validate them */
  666.   for (ci = classInfo; ci->classVar; ci++) {
  667.     classOOP = *ci->classVar;
  668.     class = (Class)oopToObj(classOOP);
  669.     class->name = internString(ci->name);
  670.     addSmalltalk(ci->name, classOOP);
  671.     class->methodDictionary = nilOOP;
  672.     index = toInt(class->subClasses);
  673.     if (classOOP == classClass) {
  674.       /*
  675.        * Object class being a subclass of Class is not an apparent link,
  676.        * and so the index which is the number of subclasses of the class
  677.        * is off by one.  We correct that here.
  678.        */
  679.       index++;
  680.     }
  681.     class->subClasses = arrayNew(index);
  682.     if (index > 0) {
  683.       arrayAtPut(class->subClasses, 1, fromInt(index));
  684.     }
  685.     if (classOOP == classClass) {
  686.       /*
  687.        * we don't want the meta class to have a subclass if we're special
  688.        * casing Object class, so back off the number of sub classes for
  689.        * the meta class.
  690.        */
  691.       index--;
  692.     }
  693.     if (classOOP == objectClass) { /* is this Object? */
  694.       /* nilOOP wasn't available during pass1, but now it is */
  695.       class->superClass = nilOOP;
  696.     } else {
  697.       /* hack the parent's subclass array */
  698.       superClassOOP = class->superClass;
  699.       addSubClass(superClassOOP, classOOP);
  700.       if (classOOP == classClass) {
  701.     /* here's where we patch in Object class is-a-subclass-of Class */
  702.     superClass = (Class)oopToObj(oopClass(objectClass));
  703.     superClass->superClass = classOOP;
  704.     addSubClass(classOOP, oopClass(objectClass));
  705.       }
  706.     }
  707.     class->objClass = newMetaclass(classOOP, index);
  708.     class->instanceVariables =
  709.       makeInstanceVariableArray(class->superClass, ci->instVarNames);
  710.     class->classVariables = makeClassVariableDictionary(class->superClass,
  711.                             ci->classVarNames);
  712.     class->sharedPools = makePoolArray(class->superClass, ci->sharedPoolNames);
  713.     if (ci->comment) {
  714.       class->comment = stringNew(ci->comment);
  715.     } else {
  716.       class->comment = nilOOP;    /* mark for later use */
  717.     }
  718.  
  719.     class->category = nilOOP;    /* not used yet. */
  720.   }
  721. }
  722.  
  723. /* runs before GC turned on */
  724. static OOP newMetaclass(classOOP, numSubClasses)
  725. OOP    classOOP;
  726. int    numSubClasses;
  727. {
  728.   OOP        superClassOOP, metaclassOOP;
  729.   Metaclass    metaclass;
  730.  
  731.   metaclass = (Metaclass)newInstance(metaclassClass);
  732.   metaclassOOP = allocOOP(metaclass);
  733.   superClassOOP = superClass(classOOP);
  734.  
  735.   if (classOOP == objectClass) {
  736.     /* Object case: make this be Class to close the circularity */
  737.     metaclass->superClass = classClass;
  738.   } else {
  739.     metaclass->superClass = oopClass(superClassOOP);
  740.     addSubClass(metaclass->superClass, metaclassOOP);
  741.   }
  742.  
  743.   /* the specifications here should match what a class should have: instance
  744.      variable names, the right number of instance variables, etc.  We could
  745.      take three passes, and use the instance variable spec for classes once
  746.      it's established, but it's easier to create them here by hand */
  747.   metaclass->name = nilOOP;
  748.   metaclass->comment = nilOOP;
  749.   metaclass->instanceVariables = 
  750.       makeInstanceVariableArray(nilOOP, 
  751. "superClass subClasses methodDictionary instanceSpec \
  752. name comment instanceVariables category \
  753. classVariables sharedPools");
  754.  
  755.   metaclass->category = nilOOP;
  756.   metaclass->subClasses = arrayNew(numSubClasses);
  757.   if (numSubClasses > 0) {
  758.     arrayAtPut(metaclass->subClasses, 1, fromInt(numSubClasses));
  759.   }
  760.   metaclass->methodDictionary = nilOOP;
  761.   metaclass->instanceSpec.intMark = 1;
  762.   metaclass->instanceSpec.isPointers = 1;
  763.   metaclass->instanceSpec.isWords = 0;
  764.   metaclass->instanceSpec.isIndexable = 0;
  765.   metaclass->instanceSpec.numFixedFields = 
  766.     (sizeof(struct ClassStruct) - sizeof(ObjectHeader))/sizeof(OOP);
  767.  
  768.   metaclass->instanceClass = classOOP;
  769.  
  770.   return (metaclassOOP);
  771. }
  772.  
  773. static void addSubClass(superClassOOP, subClassOOP)
  774. OOP    superClassOOP, subClassOOP;
  775. {
  776.   ClassDescription superClass;
  777.   int        index;
  778.  
  779.   superClass = (ClassDescription)oopToObj(superClassOOP);
  780.  
  781.   if (numOOPs(oopToObj(superClass->subClasses)) > 0) {
  782.     index = toInt(arrayAt(superClass->subClasses, 1));
  783.     arrayAtPut(superClass->subClasses, 1, fromInt(index - 1));
  784.     arrayAtPut(superClass->subClasses, index, subClassOOP);
  785.   } else {
  786.     errorf("Attempt to add subclass to zero sized class");
  787.   }
  788. }
  789.  
  790. /*
  791.  *    static void initSmalltalkDictionary()
  792.  *
  793.  * Description
  794.  *
  795.  *    This creates the SystemDictionary called Smalltalk and initializes some
  796.  *    of the variables in it.
  797.  *
  798.  */
  799. static void initSmalltalkDictionary()
  800. {
  801.   OOP        cFunctionDescsDictionary, featuresArray;
  802.   char            fullVersionString[200];
  803.   int        i, numFeatures;
  804.  
  805.   symbolTable = arrayNew(INITIAL_SYMBOL_TABLE_SIZE);
  806.  
  807.   smalltalkDictionary = systemDictionaryNew();
  808.   addSmalltalk("Smalltalk",        smalltalkDictionary);
  809.   cFunctionDescsDictionary = dictionaryNew();
  810.   addSmalltalk("CFunctionDescs",    cFunctionDescsDictionary);
  811.  
  812.   sprintf(fullVersionString, "Smalltalk version %s", versionString);
  813.   addSmalltalk("Version", stringNew(fullVersionString));
  814.  
  815. #ifdef BIG_ENDIAN
  816.   addSmalltalk("Bigendian", trueOOP);
  817. #else
  818.   addSmalltalk("Bigendian", falseOOP);
  819. #endif
  820.  
  821.   addSmalltalk("KernelInitialized", falseOOP);
  822.  
  823.   addSmalltalk("SymbolTable", symbolTable);
  824.  
  825.   for (numFeatures = 0; featureStrings[numFeatures] != NULL; numFeatures++) {
  826.   }
  827.  
  828.   featuresArray = arrayNew(numFeatures);
  829.  
  830.   for (i = 0; i < numFeatures; i++) {
  831.     arrayAtPut(featuresArray, i + 1, internString(featureStrings[i]));
  832.   }
  833.  
  834.   addSmalltalk("Features", featuresArray);
  835.  
  836.   initProcessSystem();
  837.  
  838.   addSmalltalk("Processor",        processorOOP);
  839. }
  840.  
  841. static void addSmalltalk(globalName, globalValue)
  842. char    *globalName;
  843. OOP    globalValue;
  844. {
  845.   dictionaryAtPut(smalltalkDictionary, internString(globalName), globalValue);
  846. }
  847.  
  848.  
  849. OOP findClass(classNameOOP)
  850. OOP    classNameOOP;
  851. {
  852.   return (dictionaryAt(smalltalkDictionary, classNameOOP));
  853. }
  854.  
  855. void initSTDIOObjects()
  856. {
  857.   addSTDIOObject(stdin, "stdin");
  858.   addSTDIOObject(stdout, "stdout");
  859.   addSTDIOObject(stderr, "stderr");
  860. }
  861.  
  862. static void addSTDIOObject(file, fileObjectName)
  863. FILE    *file;
  864. char    *fileObjectName;
  865. {
  866.   OOP        fileOOP, fileStreamOOP;
  867.  
  868.   fileOOP = cObjectNew(file);
  869.   fileStreamOOP = allocOOP(instantiate(fileStreamClass));
  870.   setFileStreamFile(fileStreamOOP, fileOOP, stringNew(fileObjectName));
  871.  
  872.   addSmalltalk(fileObjectName, fileStreamOOP);
  873. }
  874.  
  875.  
  876. /* runs before GC turned on */
  877. static OOP newClass(superClassOOP, isPointers, isWords, isIndexable,
  878.             numFixedFields)
  879. OOP    superClassOOP;
  880. Boolean    isPointers, isWords, isIndexable;
  881. int    numFixedFields;
  882. {
  883.   Class        class, superClass;
  884.   InstanceSpec    superInstanceSpec;
  885.  
  886.   if (superClassOOP != (OOP)nil) {
  887.     /* adjust the number of instance variables to account for inheritance */
  888.     superInstanceSpec = classInstanceSpec(superClassOOP);
  889.     numFixedFields += superInstanceSpec.numFixedFields;
  890.     superClass = (Class)oopToObj(superClassOOP);
  891.     superClass->subClasses = fromInt(toInt(superClass->subClasses) + 1);
  892.   }
  893.  
  894.   class            = (Class)allocObj(sizeof(struct ClassStruct));
  895.   class->objSize    = ROUNDED_WORDS(sizeof(struct ClassStruct));
  896.   class->objClass    = nil;
  897.   class->superClass            = superClassOOP;
  898.   class->instanceSpec.intMark        = 1;
  899.   class->instanceSpec.isPointers    = isPointers;
  900.   class->instanceSpec.isWords        = isWords;
  901.   class->instanceSpec.isIndexable    = isIndexable;
  902.   class->instanceSpec.numFixedFields    = numFixedFields;
  903.   class->subClasses            = fromInt(0);
  904.  
  905.   return (allocOOP(class));
  906. }
  907.  
  908.  
  909. void setComment(classDescOOP, commentOOP)
  910. OOP    classDescOOP, commentOOP;
  911. {
  912.     Class    class;
  913.  
  914.     class = (Class)oopToObj(classDescOOP);
  915.     class->comment = commentOOP;
  916. }
  917.  
  918.  
  919. void printOOPConstructor(oop)
  920. OOP    oop;
  921. {
  922.   InstanceSpec    instanceSpec;
  923.   OOP        classOOP;
  924.  
  925.   if (isAMetaclass(oop)) {
  926.     classOOP = findAnInstance(oop);
  927.     if (isNil(classOOP)) {
  928.       printf("<name unknown>");        /* we're a nameless class */
  929.     } else {
  930.       printClassName(classOOP);
  931.     }
  932.     printf(" class");
  933.     return;
  934.   }
  935.  
  936.   if (isAClass(oop)) {
  937.     printClassName(oop);
  938.     return;
  939.   }
  940.  
  941.   printOOPClassName(oop);
  942.  
  943.   classOOP = oopClass(oop);
  944.   instanceSpec = classInstanceSpec(classOOP);
  945.   if (instanceSpec.isIndexable) {
  946.     printf(" new: %d ", numIndexableFields(oop));
  947.   } else {
  948.     printf(" new ");
  949.   }
  950.  
  951.   /* ### still need to print the initialization for instance variables */
  952.   if (regressionTesting) {
  953.     printf("\"<%#x>\"", 0);
  954.   } else {
  955.     printf("\"<%#x>\"", oop);
  956.   }
  957. }
  958.  
  959. Boolean isAMetaclass(oop)
  960. OOP    oop;
  961. {
  962.   if (isInt(oop)) {
  963.     return (false);
  964.   }
  965.  
  966.   return (oopClass(oop) == metaclassClass);
  967. }
  968.  
  969. Boolean isAClass(oop)
  970. OOP    oop;
  971. {
  972.   OOP        classOOP;
  973.  
  974.   if (isInt(oop)) {
  975.     return (false);
  976.   }
  977.  
  978.   classOOP = oopClass(oop);
  979.   return (oopClass(classOOP) == metaclassClass);
  980. }
  981.  
  982. static void printOOPClassName(oop)
  983. OOP    oop;
  984. {
  985.   OOP        classOOP;
  986.  
  987.   if (isInt(oop)) {
  988.     classOOP = integerClass;
  989.   } else {
  990.     classOOP = oopClass(oop);
  991.   }
  992.  
  993.   printClassName(classOOP);
  994. }
  995.  
  996.  
  997. static void printClassName(classOOP)
  998. OOP    classOOP;
  999. {
  1000.   Class        class;
  1001.  
  1002.   class = (Class)oopToObj(classOOP);
  1003.   if (isNil(class->name)) {
  1004.     printf("<no class name>");
  1005.   } else {
  1006.     printString(class->name);
  1007.   }
  1008. }
  1009.  
  1010. OOP getClassSymbol(classOOP)
  1011. OOP    classOOP;
  1012. {
  1013.   Class        class;
  1014.  
  1015.   class = (Class)oopToObj(classOOP);
  1016.   return (class->name);
  1017.   /* this is the case when we have a metaclass,
  1018.      ??? I don't think that this is right, but I don't know what else to do
  1019.      here */
  1020. }
  1021.  
  1022.  
  1023. /*
  1024.  *    OOP metaclassInstance(metaclassOOP)
  1025.  *
  1026.  * Description
  1027.  *
  1028.  *    Returns the class that is the sole instance of the meta class
  1029.  *    "metaclassOOP".
  1030.  *
  1031.  * Inputs
  1032.  *
  1033.  *    metaclassOOP: 
  1034.  *        An OOP that should be a meta class.
  1035.  *
  1036.  * Outputs
  1037.  *
  1038.  *    The class that's the sole instance of "metaclassOOP".
  1039.  */
  1040. OOP metaclassInstance(metaclassOOP)
  1041. OOP    metaclassOOP;
  1042. {
  1043.   return (((Metaclass)oopToObj(metaclassOOP))->instanceClass);
  1044. }
  1045.  
  1046. /*
  1047.  *    OOP validClassMethodDictionary(classOOP)
  1048.  *
  1049.  * Description
  1050.  *
  1051.  *    Gets the method dictionary associated with "classOOP", and returns it.
  1052.  *    If the methodDictionary associated with "classOOP" is nil, one is
  1053.  *    created and installed into that class.
  1054.  *
  1055.  * Inputs
  1056.  *
  1057.  *    classOOP: 
  1058.  *        Class to get the method dictionary of.
  1059.  *
  1060.  * Outputs
  1061.  *
  1062.  *    A non-nil object of type MethodDictionary.
  1063.  */
  1064. OOP validClassMethodDictionary(classOOP)
  1065. OOP    classOOP;
  1066. {
  1067.   Class        class;
  1068.  
  1069.   /* ??? check for non-class objects */
  1070.   class = (Class)oopToObj(classOOP);
  1071.   if (isNil(class->methodDictionary)) {
  1072.     class->methodDictionary = identityDictionaryNew();
  1073.   }
  1074.  
  1075.   return (class->methodDictionary);
  1076. }
  1077.  
  1078. OOP classMethodDictionary(classOOP)
  1079. OOP    classOOP;
  1080. {
  1081.   Class        class;
  1082.  
  1083.   class = (Class)oopToObj(classOOP);
  1084.   return (class->methodDictionary);
  1085. }
  1086.  
  1087. OOP classVariableDictionary(classOOP)
  1088. OOP    classOOP;
  1089. {
  1090.   Class        class;
  1091.  
  1092.   /* ??? check for non-class objects */
  1093.   class = (Class)oopToObj(classOOP);
  1094.   return (class->classVariables);
  1095. }
  1096.  
  1097. OOP instanceVariableArray(classOOP)
  1098. OOP    classOOP;
  1099. {
  1100.   Class        class;
  1101.  
  1102.   /* ??? check for non-class  objects */
  1103.   class = (Class)oopToObj(classOOP);
  1104.   return (class->instanceVariables);
  1105. }
  1106.  
  1107. OOP sharedPoolDictionary(classOOP)
  1108. OOP    classOOP;
  1109. {
  1110.   Class        class;
  1111.  
  1112.   /* ??? check for non-class objects */
  1113.   class = (Class)oopToObj(classOOP);
  1114.   return (class->sharedPools);
  1115. }
  1116.  
  1117.  
  1118. OOP findSharedPoolVariable(classOOP, symbol)
  1119. OOP    classOOP, symbol;
  1120. {
  1121.   OOP        assocOOP, poolDictionaryOOP;
  1122.   Class        class;
  1123.   int        numPools, i;
  1124.  
  1125.   /* ??? check for non-class objects */
  1126.   class = (Class)oopToObj(classOOP);
  1127.  
  1128.   /* ??? shared pools are currently represented as arrays, from the book
  1129.      I conjecture that their shared pools are implemented as sets. */
  1130.   numPools = numOOPs(oopToObj(class->sharedPools));
  1131.   for (i = 0; i < numPools; i++) {
  1132.     poolDictionaryOOP = arrayAt(class->sharedPools, i+1);
  1133.     assocOOP = dictionaryAssociationAt(poolDictionaryOOP, symbol);
  1134.     if (!isNil(assocOOP)) {
  1135.       return (assocOOP);
  1136.     }
  1137.   }
  1138.  
  1139.   return (nilOOP);
  1140. }
  1141.  
  1142. /*
  1143.  *    Boolean isAKindOf(memberOOP, classOOP)
  1144.  *
  1145.  * Description
  1146.  *
  1147.  *    Checks to see if "memberOOP" is a subclass of "classOOP", returning
  1148.  *    true if it is.
  1149.  *
  1150.  * Inputs
  1151.  *
  1152.  *    memberOOP: 
  1153.  *        A class OOP that's to be checked for (sub)class membership.
  1154.  *    classOOP: 
  1155.  *        A class OOP that's the conjectured (super)class.
  1156.  *
  1157.  * Outputs
  1158.  *
  1159.  *    True if "memberOOP" is a (sub)class of "classOOP".
  1160.  */
  1161. Boolean isAKindOf(memberOOP, classOOP)
  1162. OOP    memberOOP, classOOP;
  1163. {
  1164.   for ( ; !isNil(memberOOP); memberOOP = superClass(memberOOP)) {
  1165.     if (memberOOP == classOOP) {
  1166.       return (true);
  1167.     }
  1168.   }
  1169.   
  1170.   return (false);
  1171. }
  1172.  
  1173. /*
  1174.  *    OOP superClass(classOOP)
  1175.  *
  1176.  * Description
  1177.  *
  1178.  *    Given an OOP for a class, this routine returns the superclass OOP for
  1179.  *    that class.  Note: this is NOT the metaclass, this is the parent class.
  1180.  *
  1181.  * Inputs
  1182.  *
  1183.  *    classOOP: 
  1184.  *        OOP that references a class.
  1185.  *
  1186.  * Outputs
  1187.  *
  1188.  *    Superclass of "classOOP".  A class OOP or nil OOP.
  1189.  */
  1190. OOP superClass(classOOP)
  1191. OOP    classOOP;
  1192. {
  1193.   return (((Class)oopToObj(classOOP))->superClass);
  1194. }
  1195.  
  1196. OOP findClassMethod(classOOP, selector)
  1197. OOP    classOOP, selector;
  1198. {
  1199.   Class        class;
  1200.   IdentityDictionary methodDictionary;
  1201.   OOP        methodDictionaryOOP;
  1202.   int        index;
  1203.  
  1204.   class = (Class)oopToObj(classOOP);
  1205.   methodDictionaryOOP = class->methodDictionary;
  1206.   if (isNil(methodDictionaryOOP)) {
  1207.     return (nilOOP);
  1208.   }
  1209.  
  1210.   index = identityDictionaryFindKeyOrNil(methodDictionaryOOP, selector);
  1211.   methodDictionary = (IdentityDictionary)oopToObj(methodDictionaryOOP);
  1212.  
  1213.   return (arrayAt(methodDictionary->values, index+1));
  1214. }
  1215.  
  1216. static OOP identityDictionaryNew()
  1217. {
  1218.   IdentityDictionary identityDictionary;
  1219.  
  1220.   identityDictionary =
  1221.     (IdentityDictionary)instantiateWith(identityDictionaryClass,
  1222.                        INITIAL_DICTIONARY_SIZE);
  1223.   identityDictionary->tally = fromInt(0);
  1224.   identityDictionary->values = arrayNew(INITIAL_DICTIONARY_SIZE);
  1225.  
  1226.   return (allocOOP(identityDictionary));
  1227. }
  1228.  
  1229. OOP identityDictionaryAtPut(identityDictionaryOOP, keyOOP, valueOOP)
  1230. OOP    identityDictionaryOOP, keyOOP, valueOOP;
  1231. {
  1232.   IdentityDictionary identityDictionary;
  1233.   Array        valuesArray;
  1234.   long        index;
  1235.   
  1236.   index = identityDictionaryFindKeyOrNil(identityDictionaryOOP, keyOOP);
  1237.   identityDictionary = (IdentityDictionary)oopToObj(identityDictionaryOOP);
  1238.  
  1239.   if (isNil(identityDictionary->keys[index])) {
  1240.     identityDictionary->tally = incrInt(identityDictionary->tally);
  1241.   }
  1242.   prepareToStore(identityDictionaryOOP, keyOOP);
  1243.   identityDictionary->keys[index] = keyOOP;
  1244.   valuesArray = (Array)oopToObj(identityDictionary->values);
  1245.   prepareToStore(identityDictionary->values, valueOOP);
  1246.   valuesArray->elements[index] = valueOOP;
  1247.  
  1248.   return (keyOOP);
  1249. }
  1250.  
  1251. static IdentityDictionary growIdentityDictionary(identityDictionaryOOP)
  1252. OOP    identityDictionaryOOP;
  1253. {
  1254.   IdentityDictionary oldIdentityDictionary, identityDictionary;
  1255.   Array        values, oldValues;
  1256.   OOP        key, valuesOOP, oldValuesOOP, oldOOP;
  1257.   long        oldNumFields, numFields, i, index;
  1258.  
  1259.   oldIdentityDictionary = (IdentityDictionary)oopToObj(identityDictionaryOOP);
  1260.   oldNumFields = numOOPs(oldIdentityDictionary) - OBJ_HEADER_SIZE_WORDS;
  1261.  
  1262.   numFields = oldNumFields * 2;
  1263.  
  1264.   identityDictionary =
  1265.     (IdentityDictionary)instantiateWith(identityDictionaryClass, numFields);
  1266.   maybeMoveOOP(identityDictionaryOOP); /* make sure that it's valid */
  1267.   oldIdentityDictionary = (IdentityDictionary)oopToObj(identityDictionaryOOP);
  1268.   identityDictionary->tally = oldIdentityDictionary->tally;
  1269.   setOOPObject(identityDictionaryOOP, identityDictionary);
  1270.   identityDictionary = (IdentityDictionary)oopToObj(identityDictionaryOOP);
  1271.  
  1272.   oldValuesOOP = oldIdentityDictionary->values;
  1273.   maybeMoveOOP(oldValuesOOP);    /* ### not sure that this is necessary */
  1274.   oldValues = (Array)oopToObj(oldValuesOOP);
  1275.   valuesOOP = arrayNew(numFields);
  1276.   values = (Array)oopToObj(valuesOOP);
  1277.   identityDictionary->values = valuesOOP;
  1278.  
  1279.   /* rehash all associations from old dictionary into new one */
  1280.   for (i = 0; i < oldNumFields; i++) {
  1281.     key = oldIdentityDictionary->keys[i];
  1282.     if (!isNil(key)) {
  1283.       index = identityDictionaryFindKeyOrNil(identityDictionaryOOP, key);
  1284.       maybeMoveOOP(key);
  1285.       identityDictionary->keys[index] = key;
  1286.       oldOOP = oldValues->elements[i];
  1287.       maybeMoveOOP(oldOOP);
  1288.       values->elements[index] = oldOOP;
  1289.     }
  1290.   }
  1291.  
  1292.   maybeMoveOOP(identityDictionary->values);
  1293.   maybeMoveOOP(identityDictionaryOOP);
  1294.   return (identityDictionary);
  1295. }
  1296.  
  1297. int identityDictionaryFindKeyOrNil(identityDictionaryOOP, keyOOP)
  1298. OOP    identityDictionaryOOP, keyOOP;
  1299. {
  1300.   IdentityDictionary identityDictionary;
  1301.   register long    index, count;
  1302.   long        numFields;
  1303.   
  1304.   identityDictionary = (IdentityDictionary)oopToObj(identityDictionaryOOP);
  1305.   for ( ; ; ) {
  1306. /* ### WRONG WRONG WRONG ### this is not accounting for the instance
  1307.    variables*/
  1308.     numFields = numOOPs(identityDictionary) - OBJ_HEADER_SIZE_WORDS;
  1309.     index = hash(keyOOP);
  1310.     index %= numFields;
  1311.     count = numFields;
  1312.  
  1313.     /* linear reprobe -- it is simple and guaranteed */
  1314.     for ( ; count > 0; index = (index + 1) % numFields, count--) {
  1315.       if (isNil(identityDictionary->keys[index])) {
  1316.     return (index);
  1317.       }
  1318.  
  1319.       if (identityDictionary->keys[index] == keyOOP) {
  1320.     return (index);
  1321.       }
  1322.     }
  1323.  
  1324.     /*
  1325.      * If we get to here, the dictionary is full, but we haven't found
  1326.      * the element that we're looking for.  Since we either return the
  1327.      * index of the element being sought, or the index of a nil element,
  1328.      * and the dictionary was full so that there was no nil element, we
  1329.      * grow the dictionary and scan it again.  We're guaranteed to exit
  1330.      * this loop via a return after at most two iterations.
  1331.      */
  1332.     identityDictionary = growIdentityDictionary(identityDictionaryOOP);
  1333.   }
  1334. }
  1335.  
  1336. /*
  1337.  *    pid(id)
  1338.  *
  1339.  * Description
  1340.  *
  1341.  *    Debug support routine.  Prints out the keys of an IdentityDictionary.
  1342.  *
  1343.  * Inputs
  1344.  *
  1345.  *    id    : an IdentityDictionary
  1346.  *
  1347.  */
  1348. pid(id)
  1349. IdentityDictionary id;
  1350. {
  1351.   int i;
  1352.  
  1353.   for (i = 0; i < toInt(id->tally); i++) {
  1354.     printf("%d: "); printObject(id->keys[i]); printf("\n");
  1355.   }
  1356. }
  1357.  
  1358. static OOP systemDictionaryNew()
  1359. {
  1360.   OOP        dictionaryOOP;
  1361.   Dictionary    dictionary;
  1362.  
  1363.   /* ^super new! */
  1364.   dictionaryOOP = dictionaryNew();
  1365.   dictionary = (Dictionary)oopToObj(dictionaryOOP);
  1366.   dictionary->objClass = systemDictionaryClass;
  1367.   return (dictionaryOOP);
  1368. }
  1369.  
  1370. OOP dictionaryNew()
  1371. {
  1372.   Dictionary    dictionary;
  1373.  
  1374.   dictionary = (Dictionary)instantiateWith(dictionaryClass,
  1375.                        INITIAL_DICTIONARY_SIZE);
  1376.   dictionary->tally = fromInt(0);
  1377.  
  1378.   return (allocOOP(dictionary));
  1379. }
  1380.  
  1381.  
  1382. int dictionarySize(dictionaryOOP)
  1383. OOP    dictionaryOOP;
  1384. {
  1385.   Dictionary    dictionary;
  1386.  
  1387.   dictionary = (Dictionary)oopToObj(dictionaryOOP);
  1388.   return (toInt(dictionary->tally));
  1389. }
  1390.  
  1391.  
  1392. OOP dictionaryAtPut(dictionaryOOP, keyOOP, valueOOP)
  1393. OOP    dictionaryOOP, keyOOP, valueOOP;
  1394. {
  1395.   OOP        associationOOP;
  1396.  
  1397.   associationOOP = associationNew(keyOOP, valueOOP);
  1398.   return (dictionaryAdd(dictionaryOOP, associationOOP));
  1399. }
  1400.  
  1401. OOP dictionaryAdd(dictionaryOOP, associationOOP)
  1402. OOP    dictionaryOOP,  associationOOP;
  1403. {
  1404.   long        index;
  1405.   Association    association;
  1406.   Dictionary    dictionary;
  1407.   OOP        value;
  1408.  
  1409.   association = (Association)oopToObj(associationOOP);
  1410.   dictionary = (Dictionary)oopToObj(dictionaryOOP);
  1411.   if (toInt(dictionary->tally) >= numOOPs(dictionary)-1) {
  1412.     dictionary = growDictionary(dictionaryOOP);
  1413.   }
  1414.  
  1415.   index = findKeyOrNil(dictionaryOOP, association->key);
  1416.   if (isNil(dictionary->assoc[index])) {
  1417.     prepareToStore(dictionaryOOP, associationOOP);
  1418.     dictionary->tally = incrInt(dictionary->tally);
  1419.     dictionary->assoc[index] = associationOOP;
  1420.   } else {
  1421.     value = associationValue(associationOOP);
  1422.     associationOOP = dictionary->assoc[index];
  1423.     setAssociationValue(associationOOP, value);
  1424.   }
  1425.  
  1426.   return (associationOOP);
  1427. }
  1428.  
  1429. /*
  1430.  *    static Dictionary growDictionary(dictionaryOOP)
  1431.  *
  1432.  * Description
  1433.  *
  1434.  *    Called when a dictionary becomes full, this routine replaces the
  1435.  *    dictionary instance that "dictionaryOOP" is pointing to with a new,
  1436.  *    larger dictionary, and returns this new dictionary as its value.
  1437.  *
  1438.  * Inputs
  1439.  *
  1440.  *    dictionaryOOP: 
  1441.  *        Object pointer to the dictionary that's to be expanded
  1442.  *
  1443.  * Outputs
  1444.  *
  1445.  *    New dictionary, with all of the old elements rehashed into it. 
  1446.  */
  1447. static Dictionary growDictionary(dictionaryOOP)
  1448. OOP    dictionaryOOP;
  1449. {
  1450.   Dictionary    oldDictionary, dictionary;
  1451.   long        oldNumFields, numFields, i, index;
  1452.   OOP        associationOOP;
  1453.   Association    association;
  1454.  
  1455.  
  1456.   oldDictionary = (Dictionary)oopToObj(dictionaryOOP);
  1457.   oldNumFields = numOOPs(oldDictionary) - 1;
  1458.  
  1459.   numFields = oldNumFields * 2;
  1460.  
  1461.   dictionary = (Dictionary)instantiateWith(oopClass(dictionaryOOP), numFields);
  1462.   dictionary->tally = oldDictionary->tally;
  1463.   maybeMoveOOP(dictionaryOOP);    /* make sure old dictionary is valid */
  1464.   oldDictionary = (Dictionary)oopToObj(dictionaryOOP);
  1465.   setOOPObject(dictionaryOOP, dictionary);
  1466.  
  1467.   /* rehash all associations from old dictionary into new one */
  1468.   for (i = 0; i < oldNumFields; i++) {
  1469.     if (!isNil(oldDictionary->assoc[i])) {
  1470.       associationOOP = oldDictionary->assoc[i];
  1471.       association = (Association)oopToObj(associationOOP);
  1472.       index = findKeyOrNil(dictionaryOOP, association->key);
  1473.       dictionary->assoc[index] = associationOOP;
  1474.       maybeMoveOOP(associationOOP);
  1475.     }
  1476.   }
  1477.  
  1478.   maybeMoveOOP(dictionaryOOP);
  1479.   return (dictionary);
  1480. }
  1481.  
  1482. /*
  1483.  *    OOP dictionaryCopy(dictionaryOOP)
  1484.  *
  1485.  * Description
  1486.  *
  1487.  *    Create and return an exact copy of "dictionaryOOP", which is a normal
  1488.  *    dictionary object.  This is a "shallow copy"; all the associations in
  1489.  *    the dictionary are the exact same ones that are in the original
  1490.  *    dictionary.  If passed nil, returns nil.
  1491.  *
  1492.  * Inputs
  1493.  *
  1494.  *    dictionaryOOP: 
  1495.  *        A dictionary object that a copy is to be made of.
  1496.  *
  1497.  * Outputs
  1498.  *
  1499.  *    An exact copy of the dictionary that we were passed.
  1500.  */
  1501. OOP dictionaryCopy(dictionaryOOP)
  1502. OOP    dictionaryOOP;
  1503. {
  1504.   Dictionary    oldDictionary, dictionary;
  1505.   long        numFields, i;
  1506.  
  1507.   if (isNil(dictionaryOOP)) {
  1508.     return (nilOOP);
  1509.   }
  1510.  
  1511.   oldDictionary = (Dictionary)oopToObj(dictionaryOOP);
  1512.   numFields = numOOPs(oldDictionary) - 1;
  1513.  
  1514.   /* ??? we may want to create a copy object routine that just mallocs and
  1515.      copies the contents verbatim; this routine would then be just a call to
  1516.      that routine. */
  1517.   dictionary = (Dictionary)instantiateWith(dictionaryClass, numFields);
  1518.   memcpy(dictionary, oldDictionary, oldDictionary->objSize << 2);
  1519.   for (i = 0; i < numFields; i++) {
  1520.     maybeMoveOOP(dictionary->assoc[i]);
  1521.   }
  1522.  
  1523.   return (allocOOP(dictionary));
  1524. }
  1525.  
  1526. OOP dictionaryAt(dictionaryOOP, keyOOP)
  1527. OOP    dictionaryOOP, keyOOP;
  1528. {
  1529.   OOP        assocOOP;
  1530.  
  1531.   assocOOP = dictionaryAssociationAt(dictionaryOOP, keyOOP);
  1532.  
  1533.   if (isNil(assocOOP)) {
  1534.     return (nilOOP);
  1535.   } else {
  1536.     return (associationValue(assocOOP));
  1537.   }
  1538. }
  1539.  
  1540. OOP dictionaryAssociationAt(dictionaryOOP, keyOOP)
  1541. OOP    dictionaryOOP, keyOOP;
  1542. {
  1543.   long        index;
  1544.   Dictionary    dictionary; 
  1545.  
  1546.   if (isNil(dictionaryOOP)) {
  1547.     return (nilOOP);
  1548.   }
  1549.  
  1550.   index = findKey(dictionaryOOP, keyOOP);
  1551.   if (index == -1) {
  1552.     return (nilOOP);
  1553.   }
  1554.   dictionary = (Dictionary)dictionaryOOP->object;
  1555.  
  1556.   return (dictionary->assoc[index]);
  1557. }
  1558.  
  1559. int findKey(dictionaryOOP, keyOOP)
  1560. OOP    dictionaryOOP, keyOOP;
  1561. {
  1562.   long        index, initindex, numFields;
  1563.   Dictionary    dictionary; 
  1564.   OOP        associationOOP;
  1565.   Association    association;
  1566.  
  1567.   dictionary = (Dictionary)oopToObj(dictionaryOOP);
  1568. #ifdef MCR_DEBUG
  1569.   fprintf(stderr,"Searching dictionary: %d\n",dictionary);
  1570. #endif
  1571.   numFields = numOOPs(dictionary) - 1;
  1572.   index = hash(keyOOP);
  1573.   index %= numFields;
  1574.  
  1575.   /* linear reprobe -- it is simple and guaranteed */
  1576.   /* NOPE! NOPE! NOPE! -- mcr */
  1577.   /* If the Dictionary is FULL then dictionaryAssociationAt */
  1578.   /* causes this to loop forever. */
  1579.   initindex = (index - 1 + numFields) % numFields;
  1580.  
  1581.   for ( ; index != initindex ; index = (index + 1) % numFields) {
  1582.     if (isNil(dictionary->assoc[index])) {
  1583.       return (index);
  1584.     }
  1585.  
  1586.     associationOOP = dictionary->assoc[index];
  1587.     association = (Association)associationOOP->object;
  1588.  
  1589.     if (equal(association->key, keyOOP)) {
  1590.       return (index);
  1591.     }
  1592.   }
  1593.   return(-1);
  1594. }
  1595.  
  1596.  
  1597. int findKeyOrNil(dictionaryOOP, keyOOP)
  1598. OOP    dictionaryOOP, keyOOP;
  1599. {
  1600.   long        index, numFields;
  1601.   Dictionary    dictionary; 
  1602.   OOP        associationOOP;
  1603.   Association    association;
  1604.  
  1605.   dictionary = (Dictionary)oopToObj(dictionaryOOP);
  1606.   numFields = numOOPs(dictionary) - 1;
  1607.   index = hash(keyOOP);
  1608.   index %= numFields;
  1609.  
  1610.   /* linear reprobe -- it is simple and guaranteed */
  1611.   for ( ; ; index = (index + 1) % numFields) {
  1612.     if (isNil(dictionary->assoc[index])) {
  1613.       return (index);
  1614.     }
  1615.  
  1616.     associationOOP = dictionary->assoc[index];
  1617.     association = (Association)associationOOP->object;
  1618.  
  1619.     if (equal(association->key, keyOOP)) {
  1620.       return (index);
  1621.     }
  1622.   }
  1623. }
  1624.  
  1625. OOP associationNew(key, value)
  1626. OOP    key, value;
  1627. {
  1628.   Association    association;
  1629.  
  1630.   association = (Association)newInstance(associationClass);
  1631.   maybeMoveOOP(key);
  1632.   maybeMoveOOP(value);
  1633.   association->key = key;
  1634.   association->value = value;
  1635.  
  1636.   return (allocOOP(association));
  1637. }
  1638.  
  1639. OOP associationValue(associationOOP)
  1640. OOP    associationOOP;
  1641. {
  1642.   return (((Association)oopToObj(associationOOP))->value);
  1643. }
  1644.  
  1645. void setAssociationValue(associationOOP, value)
  1646. OOP    associationOOP, value;
  1647. {
  1648.   prepareToStore(associationOOP, value);
  1649.   ((Association)oopToObj(associationOOP))->value = value;
  1650. }
  1651.  
  1652. void printAssociationKey(associationOOP)
  1653. OOP    associationOOP;
  1654. {
  1655.   Association    association;
  1656.  
  1657.   association = (Association)oopToObj(associationOOP);
  1658.   if (oopClass(association->key) != symbolClass) {
  1659.     printf("<unprintable key type>");
  1660.   } else {
  1661.     printSymbol(association->key);
  1662.   }
  1663. }
  1664.  
  1665. /*
  1666.  *    OOP instantiateOOPWith(classOOP, numIndexFields)
  1667.  *
  1668.  * Description
  1669.  *
  1670.  *    Returns an OOP for a newly allocated instance of "classOOP", with
  1671.  *    "numIndexFields" fields.  The OOP is adjusted to reflect any
  1672.  *    variance in size (such as a string that's shorter than a word boundary.
  1673.  *
  1674.  * Inputs
  1675.  *
  1676.  *    classOOP: 
  1677.  *        An OOP for the class to create the instance of.
  1678.  *    numIndexFields: 
  1679.  *        The number of index fields to create in the instance.  Must be
  1680.  *        >= 0.
  1681.  *
  1682.  * Outputs
  1683.  *
  1684.  *    A new OOP that holds the newly allocated instance, with possible
  1685.  *    correction for size.
  1686.  */
  1687. OOP instantiateOOPWith(classOOP, numIndexFields)
  1688. OOP    classOOP;
  1689. long    numIndexFields;
  1690. {
  1691.   Object    object;
  1692.   OOP        oop;
  1693.   InstanceSpec    instanceSpec;
  1694.  
  1695.   object = instantiateWith(classOOP, numIndexFields);
  1696.   oop = allocOOP(object);
  1697.   instanceSpec = classInstanceSpec(classOOP);
  1698.   if (!instanceSpec.isWords && !instanceSpec.isPointers) {
  1699.     initEmptyBytes(oop, numIndexFields);
  1700.   }
  1701.  
  1702.   return (oop);
  1703. }
  1704.  
  1705. /*
  1706.  *    Object instantiateWith(classOOP, numIndexFields)
  1707.  *
  1708.  * Description
  1709.  *
  1710.  *    Returns a new, initialized instance with indexable fields.  If the
  1711.  *    instance contains pointers, they are initialized to nilOOP, else they
  1712.  *    are set to real zero.
  1713.  *
  1714.  * Inputs
  1715.  *
  1716.  *    classOOP: 
  1717.  *        Class to make an instance of.  An OOP.
  1718.  *    numIndexFields: 
  1719.  *        The number if indexed instance variables this instance is to
  1720.  *        have, possibly zero.  A long.
  1721.  *
  1722.  * Outputs
  1723.  *
  1724.  *    New instance with initialized, indexed instance variables.
  1725.  */
  1726. Object instantiateWith(classOOP, numIndexFields)
  1727. OOP    classOOP;
  1728. long    numIndexFields;
  1729. {
  1730.   Object    instance;
  1731.   InstanceSpec    instanceSpec;
  1732.   long        numBytes;
  1733.   
  1734.   instance = newInstanceWith(classOOP, numIndexFields);
  1735.   instanceSpec = classInstanceSpec(classOOP);
  1736.   if (instanceSpec.isPointers) {
  1737.     nilFill(instance->data, instanceSpec.numFixedFields + numIndexFields);
  1738.   } else {
  1739.     numBytes = instanceSpec.numFixedFields + numIndexFields;
  1740.     if (instanceSpec.isWords | instanceSpec.isPointers) {
  1741.       numBytes <<= 2;
  1742.     }
  1743.     bzero(instance->data, numBytes);
  1744.   }
  1745.   return (instance);
  1746. }
  1747.  
  1748. static OOP nilVec[100];
  1749.  
  1750. void dictInit()
  1751. {
  1752.   int i;
  1753.   for (i = 0; i < 100; i++) {
  1754.     nilVec[i] = nilOOP;
  1755.   }
  1756. }
  1757.  
  1758. void nilFill(oopPtr, OOPCount)
  1759. register OOP    *oopPtr;
  1760. register long OOPCount;
  1761. {
  1762.   if (OOPCount < 100) {
  1763.     memcpy(oopPtr, nilVec, OOPCount*sizeof(OOP));
  1764.   } else {
  1765.     register long i;
  1766.  
  1767.     for (; OOPCount > 0; OOPCount -= 100) {
  1768.       i = (OOPCount > 100) ? 100 : OOPCount;
  1769.       memcpy(oopPtr, nilVec,  i*sizeof(OOP));
  1770.       oopPtr += i;
  1771.     }
  1772.   }
  1773. }
  1774.  
  1775. /*
  1776.  *    Object instantiate(classOOP)
  1777.  *
  1778.  * Description
  1779.  *
  1780.  *    Create and return a new instance of class "classOOP".  "classOOP" must
  1781.  *    be a class with no indexable fields.  The named instance variables of
  1782.  *    the new instance are initialized to nilObj, since fixed-field-only 
  1783.  *    objects can only have pointers.
  1784.  *
  1785.  * Inputs
  1786.  *
  1787.  *    classOOP: 
  1788.  *        An OOP for the class to create the instance of.
  1789.  *
  1790.  * Outputs
  1791.  *
  1792.  *    The new instance, with its fields initialized.
  1793.  */
  1794. Object instantiate(classOOP)
  1795. OOP    classOOP;
  1796. {
  1797.   Object    instance;
  1798.   InstanceSpec    instanceSpec;
  1799.   int        i;
  1800.  
  1801.   instance = newInstance(classOOP);
  1802.   instanceSpec = classInstanceSpec(classOOP);
  1803.   if (!instanceSpec.isPointers) {
  1804.     errorf("Class with non-pointer instance spec passed to instantiate");
  1805.   }
  1806.  
  1807.   for (i = 0; i < instanceSpec.numFixedFields; i++) {
  1808.     instance->data[i] = nilOOP;
  1809.   }
  1810.   return (instance);
  1811. }
  1812.  
  1813. Object newInstanceWith(classOOP, numIndexFields)
  1814. OOP    classOOP;
  1815. long    numIndexFields;
  1816. {
  1817.   Object    instance;
  1818.   register int    numBytes;
  1819.   InstanceSpec    instanceSpec;
  1820.  
  1821.   numBytes = instanceSize(classOOP);
  1822.   instanceSpec = classInstanceSpec(classOOP);
  1823.   if (instanceSpec.isPointers | instanceSpec.isWords) {
  1824.     numIndexFields <<= 2;
  1825.   }
  1826.   numBytes += numIndexFields;
  1827.   numBytes = ROUNDED_WORDS(numBytes) << 2;
  1828.   instance = (Object)allocObj(numBytes);
  1829.   instance->objSize = numBytes >> 2;
  1830.   instance->objClass = classOOP;
  1831.   maybeMoveOOP(classOOP);
  1832.   return (instance);
  1833. }
  1834.  
  1835.  
  1836. /*
  1837.  *    Object newInstance(classOOP)
  1838.  *
  1839.  * Description
  1840.  *
  1841.  *    Creates a new instance of class "classOOP".  The space is allocated,
  1842.  *    the class and size fields of the class are filled in, and the instance
  1843.  *    is returned.  Its fields are NOT INITIALIZED.  "classOOP" must
  1844.  *    represent a class with no indexable fields.
  1845.  *
  1846.  * Inputs
  1847.  *
  1848.  *    classOOP: 
  1849.  *        OOP for the class that the new instance is to be an instance
  1850.  *        of.
  1851.  *
  1852.  * Outputs
  1853.  *
  1854.  *    The new instance, with objSize and objClass filled in.
  1855.  */
  1856. Object newInstance(classOOP)
  1857. OOP    classOOP;
  1858. {
  1859.   Object    instance;
  1860.   int        numBytes;
  1861.  
  1862.   numBytes = instanceSize(classOOP);
  1863.   instance = (Object)allocObj(numBytes);
  1864.   instance->objSize = numBytes >> 2;
  1865.   instance->objClass = classOOP;
  1866.   maybeMoveOOP(classOOP);
  1867.   return (instance);
  1868. }
  1869.  
  1870. /*
  1871.  *    int oopSizeBytes(oop)
  1872.  *
  1873.  * Description
  1874.  *
  1875.  *    Returns the size of object in bytes, exclusive of the size of the
  1876.  *    object header.
  1877.  *
  1878.  * Inputs
  1879.  *
  1880.  *    oop   : An OOP to return the size of
  1881.  *
  1882.  * Outputs
  1883.  *
  1884.  *    As in the description above.
  1885.  */
  1886. int oopSizeBytes(oop)
  1887. OOP    oop;
  1888. {
  1889.   return ((oop->object->objSize << 2) - sizeof(ObjectHeader));
  1890. }
  1891.  
  1892. int instanceSize(classOOP)
  1893. OOP    classOOP;
  1894. {
  1895.   register int        numBytes;
  1896.   register InstanceSpec    instanceSpec;
  1897.  
  1898.   instanceSpec = classInstanceSpec(classOOP);
  1899.   numBytes = instanceSpec.numFixedFields;
  1900.   if (instanceSpec.isPointers | instanceSpec.isWords) {
  1901.     numBytes <<= 2;
  1902.   }
  1903.  
  1904.   return (numBytes + sizeof(ObjectHeader));
  1905. }
  1906.  
  1907. Boolean isIndexable(classOOP)
  1908. OOP    classOOP;
  1909. {
  1910.   InstanceSpec    instanceSpec;
  1911.  
  1912.   instanceSpec = classInstanceSpec(classOOP);
  1913.   return (instanceSpec.isIndexable);
  1914. }
  1915.  
  1916. #ifndef DICT_INLINES
  1917.  
  1918. static InstanceSpec classInstanceSpec(classOOP)
  1919. OOP    classOOP;
  1920. {
  1921.   Class        class;
  1922.  
  1923.   class = (Class)oopToObj(classOOP);
  1924.   return (class->instanceSpec);
  1925. }
  1926. #endif
  1927.  
  1928. Boolean checkIndexableBoundsOf(oop, index)
  1929. OOP    oop;
  1930. int    index;
  1931. {
  1932.   if (isInt(oop)) {
  1933.     return (false);
  1934.   }
  1935.  
  1936.   return (index >= 1 && index <= numIndexableFields(oop));
  1937. }
  1938.  
  1939. Boolean checkBoundsOf(oop, index)
  1940. OOP    oop;
  1941. int    index;
  1942. {
  1943.   if (isInt(oop)) {
  1944.     return (false);
  1945.   }
  1946.  
  1947.   return (index >= 1 && index <= oopNumFields(oop));
  1948. }
  1949.  
  1950. Boolean classIsPointers(classOOP)
  1951. OOP    classOOP;
  1952. {
  1953.   InstanceSpec    instanceSpec;
  1954.  
  1955.   instanceSpec = classInstanceSpec(classOOP);
  1956.   return (instanceSpec.isPointers);
  1957. }
  1958.  
  1959. Boolean isPointers(oop)
  1960. OOP    oop;
  1961. {
  1962.   InstanceSpec    instanceSpec;
  1963.  
  1964.   instanceSpec = classInstanceSpec(oopClass(oop));
  1965.   return (instanceSpec.isPointers);
  1966. }
  1967.  
  1968. int oopFixedFields(oop)
  1969. OOP    oop;
  1970. {
  1971.   InstanceSpec    instanceSpec;
  1972.  
  1973.   instanceSpec = classInstanceSpec(oopClass(oop));
  1974.   if (instanceSpec.isPointers | instanceSpec.isWords) {
  1975.     return (instanceSpec.numFixedFields);
  1976.   } else {
  1977.     return (instanceSpec.numFixedFields * sizeof(OOP));
  1978.   }
  1979. }
  1980.  
  1981. static int oopNumFields(oop)
  1982. OOP    oop;
  1983. {
  1984.   Object    object;
  1985.   InstanceSpec    instanceSpec;
  1986.   int        numFields;
  1987.  
  1988.   object = oopToObj(oop);
  1989.   instanceSpec = classInstanceSpec(oopClass(oop));
  1990.  
  1991.   numFields = (object->objSize << 2) - sizeof(ObjectHeader);
  1992.   if (instanceSpec.isPointers | instanceSpec.isWords) {
  1993.     numFields >>= 2;
  1994.   } else {            /* must be bytes */
  1995.     numFields -= oop->flags & EMPTY_BYTES;
  1996.   }
  1997.  
  1998.   return (numFields);
  1999. }
  2000.  
  2001. OOP indexOOP(oop, index)
  2002. OOP    oop;
  2003. int    index;
  2004. {
  2005.   InstanceSpec    instanceSpec;
  2006.  
  2007.   instanceSpec = classInstanceSpec(oopClass(oop));
  2008.  
  2009.   if (instanceSpec.isPointers) {
  2010.     index += instanceSpec.numFixedFields;
  2011.     return (oopToObj(oop)->data[index-1]);
  2012.   } else if (instanceSpec.isWords) {
  2013.     index += instanceSpec.numFixedFields;
  2014.     return (fromInt( ((long *)oopToObj(oop)->data)[index-1] ));
  2015.   } else {
  2016.     index += instanceSpec.numFixedFields * sizeof(OOP);
  2017.     return (fromInt( ((Byte *)oopToObj(oop)->data)[index-1] ));
  2018.   }
  2019. }
  2020.  
  2021. Boolean indexOOPPut(oop, index, value)
  2022. OOP    oop, value;
  2023. int    index;
  2024. {
  2025.   InstanceSpec    instanceSpec;
  2026.   unsigned long    valueInt;
  2027.  
  2028.   instanceSpec = classInstanceSpec(oopClass(oop));
  2029.   index += oopFixedFields(oop);
  2030.  
  2031.   if (instanceSpec.isPointers) {
  2032.     prepareToStore(oop, value);
  2033.     oopToObj(oop)->data[index-1] = value;
  2034.   } else if (instanceSpec.isWords) {
  2035.     valueInt = toInt(value);
  2036.     ((long *)oopToObj(oop)->data)[index-1] = valueInt;
  2037.   } else {
  2038.     valueInt = toInt(value);
  2039.     if (valueInt >= 256) {
  2040.       return (false);
  2041.     }
  2042.     ((Byte *)oopToObj(oop)->data)[index-1] = (Byte)valueInt;
  2043.   }
  2044.  
  2045.   return (true);
  2046. }
  2047.  
  2048. OOP indexStringOOP(oop, index)
  2049. OOP    oop;
  2050. int    index;
  2051. {
  2052.   InstanceSpec    instanceSpec;
  2053.  
  2054.   /* ??? I'm presuming that we have a string here */
  2055.  
  2056.   instanceSpec = classInstanceSpec(oopClass(oop));
  2057.   index += instanceSpec.numFixedFields;
  2058.  
  2059.   return (charOOPAt( ((Byte *)oopToObj(oop)->data)[index-1] ));
  2060. }
  2061.  
  2062. void indexStringOOPPut(oop, index, value)
  2063. OOP    oop, value;
  2064. int    index;
  2065. {
  2066.   InstanceSpec    instanceSpec;
  2067.  
  2068.   /* ??? I'm presuming that we have a string oop here */
  2069.  
  2070.   instanceSpec = classInstanceSpec(oopClass(oop));
  2071.   index += instanceSpec.numFixedFields;
  2072.  
  2073.   ((Byte *)oopToObj(oop)->data)[index-1] = charOOPValue(value);
  2074. }
  2075.  
  2076. OOP newString(len)
  2077. int    len;
  2078. {
  2079.   String    string;
  2080.   OOP        stringOOP;
  2081.  
  2082.   string = (String)newInstanceWith(stringClass, len);
  2083.   stringOOP = allocOOP(string);
  2084.   initEmptyBytes(stringOOP, len);
  2085.  
  2086.   return (stringOOP);
  2087. }
  2088.  
  2089. OOP stringNew(s)
  2090. char    *s;
  2091. {
  2092.   String    string;
  2093.   int        len;
  2094.   OOP        stringOOP;
  2095.  
  2096.   len = strlen(s);
  2097.   string = (String)newInstanceWith(stringClass, len);
  2098.   strncpy(string->chars, s, len);
  2099.  
  2100.   stringOOP = allocOOP(string);
  2101.   initEmptyBytes(stringOOP, len);
  2102.  
  2103.   return (stringOOP);
  2104. }
  2105.  
  2106. void setOOPString(stringOOP, s)
  2107. OOP    stringOOP;
  2108. char    *s;
  2109. {
  2110.   String    string;
  2111.   long        len;
  2112.  
  2113.   len = strlen(s);
  2114.   string = (String)newInstanceWith(stringClass, len);
  2115.   strncpy(string->chars, s, len);
  2116.  
  2117.   setOOPObject(stringOOP, string);
  2118.   setEmptyBytes(stringOOP, len);
  2119. }
  2120.  
  2121. Byte *stringOOPChars(stringOOP)
  2122. OOP    stringOOP;
  2123. {
  2124.   String    string;
  2125.  
  2126.   string = (String)oopToObj(stringOOP);
  2127.   return ((Byte *)string->chars);
  2128. }
  2129.  
  2130. Byte *toCString(stringOOP)
  2131. OOP    stringOOP;
  2132. {
  2133.   Byte        *result;
  2134.   int        len;
  2135.   String    string;
  2136.  
  2137.   string = (String)oopToObj(stringOOP);
  2138.   len = oopNumFields(stringOOP);
  2139.   result = (Byte *)malloc(len + 1);
  2140.   strncpy(result, string->chars, len);
  2141.   result[len] = '\0';
  2142.  
  2143.   return (result);
  2144. }
  2145.  
  2146. Byte *toByteArray(byteArrayOOP)
  2147. OOP    byteArrayOOP;
  2148. {
  2149.   Byte        *result;
  2150.   int        len;
  2151.   ByteArray    byteArray;
  2152.  
  2153.   byteArray = (ByteArray)oopToObj(byteArrayOOP);
  2154.   len = oopNumFields(byteArrayOOP);
  2155.   result = (Byte *)malloc(len);
  2156.   memcpy(result, byteArray->bytes, len);
  2157.  
  2158.   return (result);
  2159. }
  2160.  
  2161. void setOOPBytes(byteArrayOOP, bytes)
  2162. OOP    byteArrayOOP;
  2163. Byte    *bytes;
  2164. {
  2165.   ByteArray    byteArray;
  2166.   long        len;
  2167.  
  2168.   len = oopNumFields(byteArrayOOP);
  2169.   byteArray = (ByteArray)oopToObj(byteArrayOOP);
  2170.   memcpy(byteArray->bytes, bytes, len);
  2171. }
  2172.  
  2173.  
  2174. OOP instVarAt(oop, index)
  2175. OOP    oop;
  2176. int    index;
  2177. {
  2178.   InstanceSpec    instanceSpec;
  2179.  
  2180.   instanceSpec = classInstanceSpec(oopClass(oop));
  2181.  
  2182.   if (instanceSpec.isPointers) {
  2183.     return (oopToObj(oop)->data[index-1]);
  2184.   } else if (instanceSpec.isWords) {
  2185.     return (fromInt( ((long *)oopToObj(oop)->data)[index-1] ));
  2186.   } else {
  2187.     return (fromInt( ((Byte *)oopToObj(oop)->data)[index-1] ));
  2188.   }
  2189. }
  2190.  
  2191. Boolean instVarAtPut(oop, index, value)
  2192. OOP    oop, value;
  2193. int    index;
  2194. {
  2195.   InstanceSpec    instanceSpec;
  2196.   unsigned long    valueInt;
  2197.  
  2198.   instanceSpec = classInstanceSpec(oopClass(oop));
  2199.  
  2200.   if (instanceSpec.isPointers) {
  2201.     if (GCIsOn()) {
  2202.       prepareToStore(oop, value);
  2203.     }
  2204.     oopToObj(oop)->data[index-1] = value;
  2205.   } else if (instanceSpec.isWords) {
  2206.     valueInt = toInt(value);
  2207.     ((long *)oopToObj(oop)->data)[index-1] = valueInt;
  2208.   } else {
  2209.     valueInt = toInt(value);
  2210.     if (valueInt >= 256) {
  2211.       return (false);
  2212.     }
  2213.     ((Byte *)oopToObj(oop)->data)[index-1] = (Byte)valueInt;
  2214.   }
  2215.  
  2216.   return (true);
  2217. }
  2218.  
  2219. int numIndexableFields(oop)
  2220. OOP    oop;
  2221. {
  2222.   if (isInt(oop)) {
  2223.     return (0);
  2224.   }
  2225.  
  2226.   return (oopNumFields(oop) - oopFixedFields(oop));
  2227. }
  2228.  
  2229. OOP arrayNew(numElts)
  2230. int    numElts;
  2231. {
  2232.   return (allocOOP(instantiateWith(arrayClass, numElts)));
  2233. }
  2234.  
  2235. OOP arrayAt(arrayOOP, index)
  2236. OOP    arrayOOP;
  2237. int    index;
  2238. {
  2239.   return ( ((Array)oopToObj(arrayOOP))->elements[index-1]);
  2240. }
  2241.  
  2242. void arrayAtPut(arrayOOP, index, value)
  2243. OOP    arrayOOP, value;
  2244. int    index;
  2245. {
  2246.   prepareToStore(arrayOOP, value);
  2247.   ((Array)oopToObj(arrayOOP))->elements[index-1] = value;
  2248. }
  2249.  
  2250. OOP floatNew(f)
  2251. double    f;
  2252. {
  2253.   FloatObject    floatObject;
  2254.  
  2255.   /*
  2256.    * ### Seems like this can lose on architectures where floats need
  2257.    * to be aligned...there are no guarantees that the float data
  2258.    * is aligned to an 8 byte boundary, so the store could lose.
  2259.    */
  2260.   floatObject = (FloatObject)newInstanceWith(floatClass, 2);
  2261.   floatObject->value = f;
  2262.   
  2263.   return (allocOOP(floatObject));
  2264. }
  2265.  
  2266. double floatOOPValue(floatOOP)
  2267. OOP    floatOOP;
  2268. {
  2269.   Object obj;
  2270.   union {
  2271.     unsigned long l[2];
  2272.     double d;
  2273.   } hack;
  2274.  
  2275.   if (DOUBLE_ALIGNMENT > sizeof(long)) {
  2276.     /* we may not be aligned properly...fetch things out the hard way */
  2277.     obj = oopToObj(floatOOP);
  2278.     hack.l[0] = (unsigned long)obj->data[0];
  2279.     hack.l[1] = (unsigned long)obj->data[1];
  2280.     return (hack.d);
  2281.   } else {
  2282.     return (((FloatObject)oopToObj(floatOOP))->value);
  2283.   }
  2284. }
  2285.  
  2286. OOP messageNewArgs(selectorOOP, argsArray)
  2287. OOP    selectorOOP, argsArray;
  2288. {
  2289.   Message    message;
  2290.  
  2291.   message = (Message)newInstance(messageClass);
  2292.   maybeMoveOOP(selectorOOP);
  2293.   message->selector = selectorOOP;
  2294.   maybeMoveOOP(argsArray);
  2295.   message->args = argsArray;
  2296.  
  2297.   return (allocOOP(message));
  2298. }
  2299.  
  2300. OOP messageSelector(messageOOP)
  2301. OOP    messageOOP;
  2302. {
  2303.   Message    message;
  2304.  
  2305.   message = (Message)oopToObj(messageOOP);
  2306.   return (message->selector);
  2307. }
  2308.  
  2309. OOP messageArgs(messageOOP)
  2310. OOP    messageOOP;
  2311. {
  2312.   Message    message;
  2313.  
  2314.   message = (Message)oopToObj(messageOOP);
  2315.   return (message->args);
  2316. }
  2317.  
  2318.  
  2319. OOP cObjectNew(cObjPtr)
  2320. voidPtr    cObjPtr;
  2321. {
  2322.   return (cObjectNewTyped(cObjPtr,
  2323.               cTypeNew(cObjectAnonType, cObjectClass, fromInt(0))));
  2324. }
  2325.  
  2326. OOP cObjectNewTyped(cObjPtr, typeOOP)
  2327. voidPtr    cObjPtr;
  2328. OOP    typeOOP;
  2329. {
  2330.   CObject    cObject;
  2331.   CType        cType;
  2332.  
  2333.   cType = (CType)oopToObj(typeOOP);
  2334.  
  2335.   cObject = (CObject)newInstanceWith(cType->baseType, 2);
  2336.   cObject->addr = cObjPtr;
  2337.   cObject->type = typeOOP;
  2338.  
  2339.   return (allocOOP(cObject));
  2340. }
  2341.  
  2342. voidPtr cObjectValue(cObjOOP)
  2343. OOP    cObjOOP;
  2344. {
  2345.   CObject    cObject;
  2346.  
  2347.   cObject = (CObject)oopToObj(cObjOOP);
  2348.   return ((voidPtr)cObject->addr);
  2349. }
  2350.  
  2351. OOP cObjectSubtype(cObjOOP)
  2352. OOP    cObjOOP;
  2353. {
  2354.   CObject    cObject;
  2355.  
  2356.   cObject = (CObject)oopToObj(cObjOOP);
  2357.   return (cObject->type);
  2358. }
  2359.  
  2360. void setCObjectValue(cObjOOP, value)
  2361. OOP    cObjOOP;
  2362. voidPtr    value;
  2363. {
  2364.   Object    cObject;
  2365.  
  2366.   cObject = oopToObj(cObjOOP);
  2367.   cObject->data[0] = (OOP)value;
  2368. }
  2369.  
  2370. OOP allocCObject(classOOP, size)
  2371. OOP        classOOP;
  2372. unsigned long    size;
  2373. {
  2374.   voidPtr    space;
  2375.   OOP        typeOOP;
  2376.  
  2377.   space = (voidPtr)malloc((int)size);
  2378.  
  2379.   /* don't know if subtype is proper here or not */
  2380.   typeOOP = cTypeNew(nilOOP, classOOP, fromInt(1));
  2381.  
  2382.   return (cObjectNewTyped(space, typeOOP));
  2383. }
  2384.  
  2385. OOP cTypeNew(subType, baseType, numElements)
  2386. OOP subType, baseType, numElements;
  2387. {
  2388.   CType        cType;
  2389.  
  2390.   cType = (CType)newInstance(cTypeClass);
  2391.   maybeMoveOOP(subType);
  2392.   cType->subType = subType;
  2393.   maybeMoveOOP(baseType);
  2394.   cType->baseType = baseType;
  2395.   maybeMoveOOP(numElements);
  2396.   cType->numElements = numElements;
  2397.   
  2398.   return (allocOOP(cType));
  2399. }
  2400.